home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #46 (Jul 89) / Forth Stuff / LAPph < prev   
Text File  |  1989-05-17  |  4KB  |  171 lines
  1. only forth also assembler
  2.  
  3. \ Appletalk LAP protocol handler example
  4. \ 12.05.89 JL
  5.  
  6. $904 constant currentA5
  7.  
  8. DECIMAL
  9.  
  10. 12 constant ioCompletion
  11. 18    constant    ioFileName
  12. 18    constant    userData
  13. 24    constant    ioRefNum
  14. 26    constant    csCode
  15. 27    constant    ioPermission
  16. 28    constant    socket
  17. 28 constant protType
  18. 30    constant    addrBlock
  19. 30 constant handler
  20.  
  21. 9    constant     mppUnitNum    
  22. mppUnitNum 1+ negate    
  23.     constant     mppRefNum
  24.  
  25. \ LAP defs
  26. 1    constant    LAPshortDDP
  27. 2    constant    LAPLongDDP
  28. -94    constant    lapProtErr
  29. -95    constant    lapExcessCollns
  30.  
  31. 243    constant    lapWrite
  32. 244    constant    lapDetachPH
  33. 245    constant    lapAttachPH
  34.  
  35. -1    constant    lapOverrunErr
  36. -2    constant    lapCRCErr
  37. -3    constant    lapUnderrunErr
  38. -4    constant    lapLengthErr
  39.  
  40. \ DDP defs
  41. 5    constant    ddpHdSzShort
  42. 13    constant    ddpHdSzLong
  43.  
  44. 1    constant    ddpRTMP
  45. 2    constant    ddpNBP
  46. 3    constant    ddpATP
  47.  
  48. $7F    constant    ddpMaxWKS
  49. 586    constant    ddpMaxData
  50. $3ff    constant    ddpLengthMask
  51. 128    constant    ddpWKS
  52.  
  53. -91    constant    ddpSktErr
  54. -92    constant    ddpLenErr
  55. -93    constant    ddpNoBridgeErr
  56.  
  57. \ CsCode values for DDP Control calls- MPP
  58. 246    constant    ddpWrite
  59. 247    constant    ddpCloseSkt
  60. 248    constant    ddpOpenSkt
  61.  
  62. 256    constant setSelfSend
  63.  
  64. $1FA    constant    pRamByte
  65. $1FB    constant    SPConfig
  66. $291    constant    portBUse
  67. $2D8    constant    ABusVars
  68. $2DC    constant    ABusDCE
  69.  
  70. \ ABusVars block
  71. 0  constant sysLAPAddr
  72. 1  constant toRHA
  73. 8  constant dstNetNum
  74. 25 constant sysABridge
  75. 26 constant sysNetNum
  76. 28 constant vSCCEnable
  77.  
  78. header handler.start
  79.  
  80. header ATPblock 50 allot
  81. header LAP1block 8 allot
  82. header packet 586 allot
  83.  
  84. .trap     _control,async    $a404
  85. .trap        _newptr,sys        $a51E
  86.  
  87. CODE myLAP2
  88.     moveq.l    #ddpHdSzLong-2,D3
  89.     move.w    sysNetNum(a2),D2
  90.     jsr        (a4)
  91.     bne        @2
  92.     cmp.w        dstNetNum(a2),d2
  93.     bne        @1
  94.     lea        packet,a3
  95.     move.l    #586,d3
  96.     jsr        2(a4)
  97.     bne        @2
  98.     lea        LAP1block,a0
  99.     move.b    toRHA(a2),(a0)        \ dest node ID
  100.     move.b    toRHA+1(a2),1(a0)    \ source node ID
  101.     move.b    #1,2(a0)             \ LAP type = 1
  102.     move.b    toRHA+3(a2),3(a0)    \ length field MSB
  103.     move.b    toRHA+4(a2),4(a0)    \ length field LSB
  104.     move.b    toRHA+13(a2),5(a0)    \ dest skt number
  105.     move.b    toRHA+14(a2),6(a0)    \ src skt number
  106.     move.b    toRHA+15(a2),7(a0)    \ DDP prot type
  107. \    _debugger
  108. \ set up parameter block for LAPwrite call
  109. \    lea        ATPblock,a0
  110. \    move.w    #mppRefNum,ioRefNum(a0)
  111. \    move.l    #0,ioCompletion(a0)
  112. \    move.w    #LAPwrite,csCode(a0)
  113. \    lea        LAP1block,a1
  114. \    move.l    a1,addrBlock(a0)
  115. \    move.w    vSCCEnable(a2),sr        \ re-enable interrupts
  116. \    _control,async
  117. @2    rts
  118. @1    moveq.l    #0,d3
  119.     jmp        2(a4)
  120. END-CODE
  121.  
  122. header handler.end
  123.  
  124. : call.mpp
  125.     mppRefNum     ['] ATPBlock ioRefNum + w!
  126.     ['] ATPBlock call control
  127. ;    
  128.  
  129. : attach.ph ( protType handler -- flag )
  130.     ( handler )  ['] ATPBlock handler + !
  131.     ( protType ) ['] ATPBlock protType + c!
  132.     lapAttachPH  ['] ATPBlock csCode + w!
  133.     call.mpp
  134. ;
  135.  
  136. : detach.ph ( protType -- flag )
  137.     ( protType ) ['] ATPBlock protType + c!
  138.     lapDetachPH  ['] ATPBlock csCode + w!
  139.     call.mpp
  140. ;
  141.  
  142. : set.self.send ( self_send_flag | old_flag -- )
  143.     setSelfSend ['] ATPBlock csCode + w!
  144.     ( flag )    ['] ATPBlock 28 + c!
  145.     call.mpp    drop    \ result code
  146.     ['] ATPBlock 29 + c@
  147. ;
  148.  
  149. : get.sys.block  
  150.     ['] handler.end ['] handler.start - 
  151.     MOVE.L (A6)+,D0
  152.     _newptr,sys ( get memory block in system heap )
  153.     MOVE.L A0,-(A6)
  154. ;
  155.  
  156. : change.prots { | protPtr -- }
  157.     get.sys.block -> protPtr
  158.     protPtr IF
  159.         ['] handler.start protPtr 
  160.             ['] handler.end ['] handler.start - cmove
  161.         2 detach.ph 
  162.             abort" Could not detach protocol handler"
  163.         2 ['] myLAP2 ['] handler.start -
  164.             protPtr +
  165.             attach.ph
  166.             abort" Could not attach protocol handler"
  167.             255 set.self.send drop
  168.     ELSE ." Could not get memory for protocol handler"
  169.     THEN
  170.     cr ." Buffer area is at " protPtr 50 + . cr
  171. ;